home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 3032.ZIP / RLIB20.ZIP / RL_PAREN.PRG < prev    next >
Text File  |  1989-02-18  |  2KB  |  50 lines
  1. * Function..: PARENT
  2. * Author....: Richard Low
  3. * Syntax....: PARENT( [<expC>] )
  4. * Returns...: Character name of the current directory's parent directory.
  5. *             If the current directory is the root directory, then the
  6. *             root directory ('\') is returned.
  7. * Parameters: Optional name of directory to give parent for.
  8.  
  9. FUNCTION PARENT
  10. PARAMETER p_dir
  11. PRIVATE f_drive
  12.  
  13. *-- if a directory name is not provided, get the current directory
  14. IF TYPE('p_dir') != 'C'
  15.    p_dir = CURDIR()
  16. ENDIF
  17.  
  18. *-- assume no drive letter was given
  19. f_drive = ''
  20.  
  21. *-- if they provided a drive letter, save it then strip it off
  22. IF SUBSTR(p_dir,2,1) = ':'
  23.    f_drive = SUBSTR(p_dir,1,2)
  24.    *-- if only a drive letter given, get current directory for that drive
  25.    IF LEN(p_dir) = 2
  26.       p_dir = CURDIR(p_dir)
  27.    ELSE
  28.       *-- otherwise, isolate the directory part from the drive letter
  29.       p_dir = SUBSTR(p_dir,3)
  30.    ENDIF
  31. ENDIF
  32.  
  33. *-- strip the '\' from the front of the directory name if it is there
  34. IF SUBSTR(p_dir,1,1) = '\'
  35.    p_dir = SUBSTR(p_dir,2)
  36. ENDIF
  37.  
  38. *-- if there are no more backslashes in the directory name, then will
  39. *-- be only one directory level deep, so return the root directory
  40. IF .NOT. '\' $ p_dir
  41.    RETURN f_drive + '\'
  42. ENDIF
  43.  
  44. *-- otherwise, parse and strip off the trailing directory
  45.  
  46. *-- if directory = '\APPS\CLIPPER\TEST' this will return '\APPS\CLIPPER'
  47. *-- if directory = 'F:\USERS\RICHARD' this will return 'F:\USERS'
  48.  
  49. RETURN ( f_drive + '\' + SUBSTR( p_dir, 1, RAT('\',p_dir)-1 ) )
  50.